home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / PROBLEMS / BENCHMARK / BUBBLESORT / bubbletest / tile-forth / source < prev    next >
Text File  |  1992-05-17  |  1KB  |  51 lines

  1. \ A classical benchmark of an O(n**2) algorithm; Bubble sort
  2. \
  3. \ Part of the programs gathered by John Hennessy for the MIPS
  4. \ RISC project at Stanford. Translated to forth by Marty Fraeman
  5. \ Johns Hopkins University/Applied Physics Laboratory.
  6. \
  7. \ a little bit modified for bubblesort benchmark test on acorn archimedes
  8.  
  9. os
  10. string
  11.  
  12. variable pseudorandom ( -- addr)
  13.  
  14. : initiate-pseudorandom ( -- )  123456 pseudorandom ! ;
  15. : random  ( -- n )  pseudorandom @ 234567 + 567 mod 345 + dup pseudorandom ! ;
  16.  
  17. 1000 constant elements ( -- int)
  18.  
  19. align create list elements cells allot
  20.  
  21. : initiate-list ( -- )
  22.   list elements cells + list do random i ! cell +loop
  23. ;
  24.  
  25. : dump-list ( -- )
  26.   list elements cells + list do i @ . cell cr +loop
  27. ;
  28.  
  29. : bubble-with-flag ( -- )
  30.   1 elements 1 do
  31.     true list elements i - cells bounds do
  32.       i 2@ < if i 2@ swap i 2! drop false then
  33.     cell +loop 
  34.     if leave then
  35.   loop
  36. ;
  37.   
  38. : start ( -- )
  39.   initiate-pseudorandom
  40.   initiate-list
  41.   dump-list
  42.   " time " oscli
  43.   bubble-with-flag
  44.   " time " oscli
  45.   dump-list
  46. ;
  47.  
  48. start
  49. bye
  50. bye
  51.